Analyzing Bidding Data For NUS Psychology Modules

Render

PsychMods

Codes

• Notes:
  1. AY2017/2018 Semester 2 and AY2018/2019 Semester 2 bidding data not available.
  2. The bidding statistics are highly non-normal due to being bounded by zero (they cannot make negative bids or have negative bidders). May consider using zero-inflated or poisson regression if considering these statistics as dependent variables.

Phase 1: Setting Up Environment, Packages And Loading Data

Packages And Options

library(semTools)
library(ggplot2)
library(rjson)
library(stringr)
library(DT)
library(psych)
library(corrplot)
library(tidyverse)
library(forcats)
library(lme4)
library(shiny)
library(semTools)
library(plotly)
options(width = 999)
knitr::opts_chunk$set(dpi = 96, out.width = "20%", eval = TRUE)

Load Bidding Data

• Extract data from nusmods at https://api.nusmods.com/.
• After loading the data in .JSON format, convert to a dataframe.

myBid <- data.frame() # create empty dataframe which will act as a container to be populated with data
for(year in c(2011:2018)) # looping through each year
{
  for(semester in c(1,2)) # loopinig through semesters
  {
    if(year == 2017 & semester == 2) # there is no cors biding data for 2017/2018 sem 2
    {
    } else if(year == 2018 & semester == 2) # there is no cors biding data for 2018/2019 sem 2
    {
    } else
    {
      # create the url where data is to be extracted from
      myurl <- paste0("https://api.nusmods.com/", year, "-", year + 1, "/", semester, "/corsBiddingStatsRaw.json")
      myjson <- fromJSON(file = url(myurl))
      for(r in 1:length(myjson)) # for each element in the myjson list, append it to myModInfo
      {
        if(isTRUE(str_detect(myjson[[r]][["ModuleCode"]], "^PL"))) # only keep info if module code begins with PL
        {
          if(myjson[[r]][["Semester"]] == "1" | myjson[[r]][["Semester"]] == "2") # only get semester 1 and 2 information
          {
            myBid <- rbind(myBid, myjson[[r]]) # add to dataframe
          }
        }
        myjson[[r]] <- NA # replace the element with NA to free up some rAM
      }
    }
    cat(year, "Semester", semester, "Done!") # progress tracker
  }
}
saveRDS(myBid, file = "myBid.RDS") # save to directory

Load myBid.RDS

• Downloading the data from the API using the code above takes a substantial amount of time.
• I saved the downloaded data in myBid.RDS and load it directly from my local folder while I worked on the project.

myBid <- readRDS("myBid.RDS")

Load Module Information

• Module information was scattered across different folders.
• Used a loop to repeat the process of downloading and converting to dataframe across the different folders accessed by the different URLs.
  • The same concept was used to consolidate information about the Module Titles.

myModInfo <- data.frame() # create empty dataframe which will act as a container to be populated with data
for(year in c(2011:2018)) # looping through each year
{
  for(semester in c(1,2))
  {
    # create the url where data is to be extracted from
    myurl <- paste0("https://api.nusmods.com/", year, "-", year + 1, "/", semester, "/moduleTimetableDeltaRaw.json")
    myjson <- fromJSON(file = url(myurl))
    for(r in 1:length(myjson)) # for each element in the myjson list, append it to myModInfo
    {
      if(isTRUE(str_detect(myjson[[r]]$ModuleCode, "^PL"))) # only keep info if module code begins with PL
      {
        if(myjson[[r]]$Semester == 1 | myjson[[r]]$Semester == 2) # only get semester 1 and 2 information
        {
          myModInfo <- rbind(myModInfo, myjson[[r]]) # add to dataframe
        }
      }
      myjson[[r]] <- NA # replace the element with NA to free up some rAM
    }
    cat(year, "Semester", semester, "Done!") # progress tracker
  }
}

myTitles <- data.frame() # create empty dataframe which will act as a container to be populated with data
for(year in c(2014:2018)) # looping through each year
{
    myurl <- paste0("https://api.nusmods.com/", year, "-", year + 1, "/moduleList.json") # create the url where data is to be extracted from
    myjson <- fromJSON(file = url(myurl))
    for(r in 1:length(myjson)) # for each element in the myjson list, append it to myModInfo
    {
      if(isTRUE(str_detect(myjson[[r]]$ModuleCode, "^PL"))) # only keep info if module code begins with PL
      {
        if(paste0(myjson[[r]]$Semester, collapse = "|") == "1"|
           paste0(myjson[[r]]$Semester, collapse = "|") == "2"|
           paste0(myjson[[r]]$Semester, collapse = "|") == "1|2") # only keep information from semester 1 and 2
        {
          myTitles <- rbind(myTitles, as.data.frame(myjson[[r]])) # add to dataframe
        }
      }
      myjson[[r]] <- NA # free RAM
    }
}

myModInfo <- myTitles %>% # add titles information to myModInfo
  select(ModuleCode, ModuleTitle) %>% # select these two columns
  filter(ModuleTitle != "Lab in Applied Psychology") %>%
  distinct() %>% # remove duplicates
  right_join(myModInfo, by = "ModuleCode") # left = myTitles, right = myModInfo

saveRDS(myModInfo, file = "myModInfo.RDS") # save to directory

Load myModInfo.RDS

• Downloading the data from the API using the code above takes a substantial amount of time.
• I saved the downloaded data in myModInfo.RDS and load the data directly while I worked on the project.

myModInfo <- readRDS("myModInfo.RDS")

Phase 2: Filter, Transform And Merge

Module Information

• Filter information from the dataframe myModInfo.
  • Removing non-Psychology modules.
  • Removing modules without module titles, these are modules that appeared before AY2014/2015 and never resurfaced afterwards.
  • Removing information about tutorials.

Filter

myModInfo <- myModInfo %>%
  select(-LastModified, -LastModified_js, -isDelete) %>% # remove these columns
  filter(str_detect(ModuleCode, "^PL")) %>% # removing non-Psychology modules
  filter(!is.na(ModuleTitle)) %>% # removing modules without module titles #PL3285, PL4220, PL4217
  filter(LessonType != "TUTORIAL") %>% # removing information about tutorials
  select(AcadYear, Semester, ModuleCode, ModuleTitle, DayText, StartTime, Semester, ClassNo) %>%# select these columns
  distinct(AcadYear, Semester, ModuleCode, ClassNo, DayText, StartTime, .keep_all = TRUE) # remove duplicates
modrow <- nrow(myModInfo) # get number of rows of myMoInfo
myModInfo <- myModInfo %>%
  mutate(rowindex = 1:modrow) %>% # create new row that is the row number
  arrange(-rowindex) %>% # invert the dataframe, make it upside down, reason: latest entry are appended to the bottom of the dataframe!
  distinct(AcadYear, Semester, ModuleCode, ClassNo, .keep_all = TRUE) %>% # remove duplicates based on these columns
  select(-rowindex) # remove rowindex

tail(myModInfo) # peek

Bidding Information

• Filter information from the dataframe myBid.
  • Removing non-Psychology modules, including Roots and Wings (prefixed with PLS-) and Psychology for non-Psychology students (prefixed with PLB-).
  • Removing information from quotas that are reserved and not available for bidding.
  • Removing information from modules with more than one lecture/seminar session.
  • Removing bidding information from non-psychology students.
• Create new variable ClassNo by transforming from Group such that this information can be used to merge with myModInfo.

Filter & Transform

myBid <- myBid %>%
  filter(str_detect(ModuleCode, "^PL")) %>% # removing non-Psychology modules
  filter(!str_detect(ModuleCode, "PLS|PLB")) %>% # remove PLS and PLB modules
  filter(!str_detect(StudentAcctType, "Reserved")) %>% # remove reserved rounds
  filter(!str_detect(StudentAcctType, "[G]")) %>% # remove bidding information from non-psychology students
  select(-Faculty) %>%  # remove this columns
  mutate(Group1 = gsub("-", "", Group)) %>% # remove hyphens such that it works with parse_number()
  mutate(ClassNo = as.character(parse_number(Group1))) # new column signifying which lecture slots for modules with >1 lecture slots

head(myBid) # peek

Merge

• Combine the information of myModInfo and myBid.

# modules that do not appear in both dataframes are dropped
mydata <- inner_join(myBid, 
                     myModInfo,
                     by = c("ModuleCode", "AcadYear", "Semester", "ClassNo"))
head(mydata) # peek

Phase 3: Data Wrangling

• The variables available in the original data are useful but they are too specific to interpret meaningfully.
• This section creates new variables based on the original data and allow us to better discern any trend in the data.
• Also includes additional wrangling and manipulations to ease the plotting of graphs and analysis later.

Coercing Columns

# transform these columns to numeric
for(r in c("Quota", "Bidders", "LowestBid", "LowestSuccessfulBid", "HighestBid", "StartTime"))
{
  mydata[,grep(r, names(mydata))] <- as.numeric(mydata[,grep(r, names(mydata))])
}
# transform these columns to factors
for(r in c("AcadYear", "Semester", "ModuleCode", "Round", "StudentAcctType", "DayText", "StudentAcctType", "ModuleTitle", "Group$", "ClassNo"))
{
  mydata[,grep(r, names(mydata))] <- factor(mydata[,grep(r, names(mydata))])
}

Rearranging DayText Levels

mydata$DayText <- factor(mydata$DayText,
                         levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday"))

Shortening StudentAcctType Levels

mydata <- mutate(mydata, StudentAcctType = fct_recode(StudentAcctType, 
                                                      "New[P]" = "New Students [P]",
                                                      "NUS[P]" = "NUS Students [P]",
                                                      "Return[P]" = "Returning Students [P]",
                                                      "ReturnNew[P]" = "Returning Students and New Students [P]"))

Shortening Group Levels

mydata <- mutate(mydata, Group = fct_recode(Group, 
                                                      "LEC1" = "LECTURE 1",
                                                      "LEC2" = "LECTURE 2",
                                                      "SEMINAR1" = "SEMINAR-STYLE MODULE CLASS 1",
                                                      "SEMINAR2" = "SEMINAR-STYLE MODULE CLASS 2"))

New Variable: Level

# create new variable that indicates the level of the module, based on their module code
mydata$Level <- factor(ifelse(str_detect(mydata$ModuleCode, "1[0-9][0-9][0-9]"), "Level 1",
                      ifelse(str_detect(mydata$ModuleCode, "2[0-9][0-9][0-9]"), "Level 2",
                             ifelse(str_detect(mydata$ModuleCode, "3[0-9][0-9][0-9]"), "Level 3",
                                    ifelse(str_detect(mydata$ModuleCode, "4[0-9][0-9][0-9]"), "Level 4", 
                                           "Graduate Module")))))

New Variable: BidPerQuota

# BidPerQuota = Bidders/Quota
mydata$BidPerQuota <- with(mydata, Bidders/Quota)

New Variable: DayPeriod

mydata$Period <- factor(ifelse(mydata$StartTime < 1200, "Morning", ">=Afternoon"),
                           levels = c("Morning", ">=Afternoon"))

New Variable: Category

mydata$Category <- ifelse(str_detect(mydata$ModuleCode, "^PL328"), "Lab",
                          ifelse(str_detect(mydata$ModuleCode, "^PL4[0-9][0-9][0-9]"), "Honor",
                                 ifelse(str_detect(mydata$ModuleCode, "PL323[2-6]|PL1101|PL213[1-2]"), "Core", "Elective")))
mydata$Category <- factor(mydata$Category,
                         levels = c("Core", "Elective", "Lab", "Honor"))

Vector Of Column Names

# create vector of the column names which are factors
facnames <- mydata %>% select_if(is.factor) %>% names()
# facnames without ModuleCode and StudentAcctType
facnames.mod <- facnames[-grep("ModuleCode|ModuleTitle", facnames)]
# create vector ofthe column names which are numeric
numnames <- mydata %>% select_if(is.numeric) %>% names()
# numnames without StartTime
numnames.time <- names(select_if(mydata, is.numeric))[-grep("StartTime", numnames)]

Phase 4: Data Diagnostics

• Plot univariate histograms and bivariate plots using loops for almost every combination of variables.
• The graphs from this section are predominantly for diagnostics rather than exploration, what I mean is that the graphs from this section would make little sense if one tried to draw insights from them. This is because they are aggregated across all other variables.
  • For example: The mean of Bidders is calculated across all academic years, all bidding rounds, all modules…
• What I am looking out for in this section are odd patterns, like zeroes in places where they shouldn’t be, missing data, highly non-normal data, variables with outliers, etc…

Univariate Descriptive Statistics

str(mydata)

## 'data.frame':    1934 obs. of  20 variables:
##  $ AcadYear           : Factor w/ 8 levels "2011/2012","2012/2013",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Semester           : Factor w/ 2 levels "1","2": 2 2 2 2 2 2 2 2 2 2 ...
##  $ Round              : Factor w/ 7 levels "1A","1B","1C",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ ModuleCode         : Factor w/ 87 levels "PL1101E","PL2131",..: 1 1 2 2 3 3 4 4 5 5 ...
##  $ Group              : Factor w/ 4 levels "LEC1","LEC2",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Quota              : num  95 430 5 12 35 35 28 50 25 22 ...
##  $ Bidders            : num  10 100 3 42 8 3 7 2 8 5 ...
##  $ LowestBid          : num  1 1 1 205 1 1 1 1 1 1 ...
##  $ LowestSuccessfulBid: num  1 1 1 977 1 1 1 1 1 1 ...
##  $ HighestBid         : num  500 1150 368 1255 500 ...
##  $ StudentAcctType    : Factor w/ 4 levels "New[P]","NUS[P]",..: 3 1 3 1 3 1 3 1 3 1 ...
##  $ Group1             : chr  "LECTURE 1" "LECTURE 1" "LECTURE 1" "LECTURE 1" ...
##  $ ClassNo            : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
##  $ ModuleTitle        : Factor w/ 85 levels "Abnormal Psychology",..: 34 34 74 74 75 75 8 8 13 13 ...
##  $ DayText            : Factor w/ 5 levels "Monday","Tuesday",..: 1 1 3 3 2 2 2 2 3 3 ...
##  $ StartTime          : num  1800 1800 1600 1600 800 800 1200 1200 1400 1400 ...
##  $ Level              : Factor w/ 4 levels "Level 1","Level 2",..: 1 1 2 2 2 2 3 3 3 3 ...
##  $ BidPerQuota        : num  0.105 0.233 0.6 3.5 0.229 ...
##  $ Period             : Factor w/ 2 levels "Morning",">=Afternoon": 2 2 2 2 1 1 2 2 2 2 ...
##  $ Category           : Factor w/ 4 levels "Core","Elective",..: 1 1 1 1 1 1 1 1 1 1 ...

select(describe(mydata), n, mean, sd, median, min, max, skew, kurtosis)

## Warning in describe(mydata): NAs introduced by coercion

## Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf

## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf

Univariate Histograms/Boxplots

• Plots to illustrate the frequency/distribution of variables.

Categorical Variables

# plot the categorical variables
for(r in facnames.mod)
{
  plot(
    ggplot(data = mydata, aes_string(x = r, fill = r)) + 
      geom_histogram(stat = "count") + 
      ylab("Count") +
      ggtitle(paste0("Count of ", r)) +
      theme_classic() + 
      theme(axis.text.x = element_text(angle = 90),
            axis.title.x = element_blank(),
            legend.position = "none")
  )
}

Continuous Variables

# plot the continuous variables
for(r in numnames)
{
  plot(
    ggplot(data = mydata, aes_string(x = r, fill = r)) + 
      geom_histogram(fill = "violetred", alpha = 0.5, bins = 50) + 
      ylab("Histogram") +
      ggtitle(paste0(r)) +
      theme_classic() + 
      theme(axis.text.x = element_text(angle = 90),
            axis.title.x = element_text())
  )
}

Bivariate Plots

• Plots to illustrate pairwise relationships amongst variables.

Categorical-Categorical

for(r in 1:length(facnames.mod)) # loop across all factors
{
  for(i in 1:length(facnames.mod)) # inner loop
  {
    if(i == r | i < r) 
    { # dont do anything if they are the same or the graph has been made before
    } else {
      tempform <- paste0("~ ", facnames.mod[r], " + ", facnames.mod[i])  # create formula for xtabs
      # temp is a dataframe that is only going to exist in this section and overwritten with each loop
      temp <- as.data.frame(xtabs(eval(parse(text = tempform)),
                                  data = mydata,
                                  subset = NULL))
      plot(
        ggplot(data = temp, aes_string(x = facnames.mod[r], y = facnames.mod[i], fill = "Freq", label = "Freq")) +
          geom_tile() + 
          geom_text() + 
          scale_fill_gradient(low = "white", high = "violetred") + 
          theme_minimal() + 
          theme(axis.text.x = element_text(angle = 90),
                legend.position = "none")
      )
    }
  }
}

Continuous-Continuous

for(r in 1:length(numnames)) # loop across all numeric columns
{
  for(i in 1:length(numnames)) # inner loop
  {
    if(i == r | i < r)
    { # dont do anything if they are the same or the graph has been made before
    } else {
      # create formulas for lm()
      tempform.std <- paste0("scale(", numnames[i],")", " ~ ", "scale(", numnames[r], ")") # standardized
      tempform <- paste0(numnames[i], " ~ ", numnames[r]) # unstandardized
      # regress to get best fit line
      stdreg <- lm(eval(parse(text = tempform.std)),
                   data = mydata) # standardized
      reg <- lm(eval(parse(text = tempform)),
                data = mydata) # unstandardized
      
      plot(
        ggplot(data = mydata, aes_string(x = numnames[r], y = numnames[i])) +
          geom_point(color = "violetred", size = 2, alpha = 0.3) +
          theme_classic() + 
          geom_abline(slope = reg$coefficients[2], intercept = reg$coefficients[1], lty = "dashed") + 
          geom_label(aes(x = Inf, y = Inf, label = paste0("Standardized Regression Coefficient = ",
                                                          round(stdreg$coefficients[2],3)),
                         hjust = 1, vjust = 2)) + 
          theme(axis.text.x = element_text(angle = 90))
      )
    }
  }
}

Continuous-Categorical

for(r in facnames.mod) # loop across all factor columns
{
  for(i in numnames) # inner loop across all numeric columns
  {
    plot(
      ggplot(data = mydata, aes_string(x = r, y = i, fill = r)) + 
        geom_boxplot() + 
        theme_classic() + 
        theme(legend.position = "none",
              axis.text.x = element_text(angle = 90))
    )
  }
}

Correlation Matrix

corrplot.mixed(cor(mydata[,grep(paste0(numnames.time, collapse = "|"), names(mydata))]), # only get the numeric columns
               upper = "color",
               tl.pos = "lt",
               tl.cex = 0.5,
               cl.cex = 0.5)

Phase 5: Supplementary Graphs

Cumulative Distribution Function Of Quota Across Category (1A)

for(r in c("Core", "Elective", "Lab", "Honor"))
{
  plot(mydata %>%
         filter(Category ==  r) %>%
         filter(Round == "1A") %>%
         mutate(ModuleCode = fct_reorder(ModuleCode, Quota)) %>%
         ggplot(mapping = aes(Quota)) + 
         stat_ecdf(geom = "step", size = 0.5) +
         ylab("Cumulative Distribution") +
         ggtitle(r) +
         theme_classic() +
         theme(legend.position = "none",
               title = element_text(size = 7)))
}

Quota Of Each Module Across Time

for(r in sort(as.character(unique(mydata$ModuleCode))))
{
  plot(
    mydata %>% 
    filter(ModuleCode == r) %>%
    filter(Round == "1A") %>%
    mutate(AcadSem = paste0(AcadYear,"/S" ,Semester)) %>%
    group_by(ModuleCode, AcadSem) %>%
    summarize(meanQuota = mean(Quota)) %>%
    ggplot(mapping = aes(x = AcadSem, y = meanQuota, group = ModuleCode)) +
    geom_point() + 
    geom_path() + 
    ggtitle(r) +
      ylim(c(0,200)) + 
    theme_classic() +  
    theme(axis.text.x = element_blank(), 
          legend.position = "top",
          strip.background = element_rect(fill = "grey30", linetype = "blank"),
          strip.text = element_text(color = "white", size = 12))
    )
  
}

LSB Of Each Module Across Time

for(r in sort(as.character(unique(mydata$ModuleCode))))
{
  plot(
    mydata %>% 
    filter(ModuleCode == r) %>%
    filter(Round == "1A") %>%
    mutate(AcadSem = paste0(AcadYear,"/S" ,Semester)) %>%
    group_by(ModuleCode, AcadSem) %>%
    summarize(meanLSB = mean(LowestSuccessfulBid)) %>%
    ggplot(mapping = aes(x = AcadSem, y = meanLSB, group = ModuleCode)) +
    geom_point() + 
    geom_path() + 
    ggtitle(r) +
      ylim(c(0,2200)) + 
    theme_classic() +  
    theme(axis.text.x = element_blank(), 
          legend.position = "top",
          strip.background = element_rect(fill = "grey30", linetype = "blank"),
          strip.text = element_text(color = "white", size = 12))
    )
  
}

Do less people bid for a module if the lecture begins in the morning (before 12pm)?

Lets look at each module and compare the average number of bidders, bidders per quota and lowest successful bids when the lecture begins in and after the morning.

By Module

for(r in c("meanBidders", "meanBpQ", "meanLSB"))
{
  plot(mydata %>%
    group_by(ModuleCode, ModuleTitle, Period) %>%
    summarise(meanBidders = mean(Bidders), meanBpQ = mean(BidPerQuota), meanLSB = mean(LowestSuccessfulBid),
              sdBidders = sd(Bidders), sdBpQ = sd(BidPerQuota), sdLSB = mean(LowestSuccessfulBid)) %>%
    ggplot(aes_string(x = "Period", y = r, fill = "Period")) +
    geom_bar(stat = "identity") +
    theme_classic() +  
    theme(axis.text.x = element_blank(), 
          legend.position = "top",
          strip.background = element_rect(fill = "grey30", linetype = "blank"),
          strip.text = element_text(color = "white", size = 12)) + 
    facet_grid(~ ModuleCode:ModuleTitle, labeller = label_wrap_gen(width = 25)) +
    ggtitle(r))
}

By Level

for(r in c("meanBidders", "meanBpQ", "meanLSB"))
{
  plot(mydata %>%
    group_by(Level, Period) %>%
    summarise(meanBidders = mean(Bidders), meanBpQ = mean(BidPerQuota), meanLSB = mean(LowestSuccessfulBid),
              sdBidders = sd(Bidders), sdBpQ = sd(BidPerQuota), sdLSB = mean(LowestSuccessfulBid)) %>%
    ggplot(aes_string(x = "Period", y = r, fill = "Period")) +
    geom_bar(stat = "identity") +
    theme_classic() +  
    theme(axis.text.x = element_blank(), 
          legend.position = "top",
          strip.background = element_rect(fill = "grey30", color = "black"),
          strip.text = element_text(color = "white", size = 12)) + 
    facet_wrap(~ Level) +
    ggtitle(r))
}

Bonus: Multilevel Modeling

Less Than 3 Instances

mymlm <- mydata %>%
  group_by(ModuleCode) %>%
  filter(n() >= 3)

With No Variability In StartTime

# # remove those with no variability in StartTime
mymlm <- mydata %>%
  group_by(ModuleCode) %>%
  mutate(sdBpQ = sd(BidPerQuota), sdStartTime = sd(StartTime)) %>%
  filter(sdStartTime > 0) %>%
  arrange(sdBpQ)

Hours From 12am Hrs12 And Group-Mean Centered Hrs12.

mymlm <- mymlm %>% 
  mutate(Hrs12 = StartTime/100) %>%
  group_by(ModuleCode) %>%
  arrange()

Peek Data

head(mymlm)

Models

Baseline Model

fit0 <- lmer(BidPerQuota ~ 1 + (1 | ModuleCode),
     data = mymlm)
VarCorr(fit0)

(0.3672^2)/((0.3672^2) + (0.67259^2))

With Hrs12.gmc

fit1 <- lmer(avgLSB ~ Level*Hrs12.gmc + (1 | ModuleCode),
     data = mymlm)
summary(fit1)
car::Anova(fit1)

Do results from previous rounds…

head(mydata)

a <- mydata %>%
  pivot_wider(names_from = Round,
         values_from = BidPerQuota
         )

Post

Module Biddiing

My favourite part of university education was the ability to pick and choose modules. Excluding the compulsory modules, we were frequently spoiled for choice when it came to the electives. But this freedom came at a cost, we had to bid for the modules instead of simply being assigned them. The bidding system (CORS) was created to cope with the reality that certain modules were in higher demand, yet the modules had limited capacity. Students had to carefully ration their limited bid points, which were used to win auctions for desired modules. Do you go all-in on an extremely popular module and be stuck with no points to bid for the remaining modules? Or spread the risk and bid moderately on multiple modules that align with your interest?

Inadvertently, we began to evaluate the demand or popularity of each module to guide our bidding choices. We might even advise juniors or peers based on such evaluations. For example:

Psychological Therapies is the most popular module, so you need to plan ahead and stockpile points from previous semesters if you plan on bidding for them.

The above originated from observing peers grief over their inability to secure a place in Psychological Therapies due to the exhorbitant amount of points required (which required students to stockpile points from previous semesters). But I have never heard anyone claiming that they really wanted to study Cognitive Neuroscience but failed to bid for it.
But was it true that Psychological Therapies was the most popular module? Rather than inferring popularity from personal anecdotes and observation, do we have data to support this claim? The answer is yes! Past bidding statistics and other module information are available at https://nusmods.com/api/. All thanks to the team at NUSMods who created a great timetabling tool for all NUS students. With these data, we can pitch the question broader and ask,

What were the most popular modules?

The information was downloaded, extracted, transformed, analysed and visualized using R. The codes are available under Codes tab above. The API contains extracted data for all modules from different majors and faculty but I will focus only on Psychology modules in this post as I have greater familiarity with them.

---

Module Categories

For the typical Psychology major, there are broadly four categories of modules.

Categories	Description
Core Modules	Modules that are required for all undergraduates. Includes PL1101E, PL2131, PL2132, PL3232 to PL3236.
Level 3 Elective Modules	Modules that are outside of the core modules. Between four to six of these are required by all undergraduates to graduate. Their module codes run from PL3237 to PL3260.
Level 3 Lab Modules	Lab modules are structured as individual or group research projects in a specific domain of Psychology. Every undergraduate is required to complete at least one of these modules. Their module codes are prefixed with PL328x.
Level 4 Honor Modules	Modules that are required to graduate on the Honors track, usually taken near the end of the undergraduate degree. Between five to eight of these are required to graduate. They are prefixed with PL4xxx.

Core modules were usually simple to get and would most likely be allocated to you in the Module Preference Exercise (more on that later…). Within the other three categories, what were the most popular modules?

---

Popularity

To proceed, we would need some consensus on what popularity is and how to it. Luckily, the data contained bidding statistics that could be indicators of popularity. These are the key bidding statistics/variables:

1. Quota
   • The maximum number of students allowed in the module.
2. Bidders
   • The number of students who placed a bid on the module.
3. Bidders Per Quota (BpQ)
   • The number of bidders for each available quota, \(BpQ = \frac{Bidders}{Quota}.\)
   • A value above 1 indicates that the module had more bidders than quota and a value below 1 indicates the opposite.
4. Lowest Successful Bid (LSB)
   • The lowest bid that is allocated the module, students who bidded below this value will not be allocated the module.
     The bar graphs below illustrates the mean Quota, Bidders, BpQ and LSB of each module category, calculated across all modules, semesters and rounds. The different categories vary greatly in these statistics and their importance to the undergraduate program, which makes it difficult to meaningfully compare popularity across categories.

We define a popular modulea as possessing the following characteristic in Round 1A (the first round of bidding):

1. Maximum Quota available.
   • Some background on the bidding system: Round 1A is officially the first round but there is a Module Preference Exercise before Round 1A. In this exercise, all students declare the modules that they wish to study for the coming semester.
   • When the total number of students that wish to study a particular module is less than the quota (demand < supply), these students will be allocated the module for free. The unfilled quota will be up for bidding in Round 1A.
   • If the number of interested students exceed the quota (demand > supply), no students will be allocated the module and all quotas will be up for bidding. Popular modules are expected to fall into this scenario, thus their quota in Round 1A should be at a maximum.
2. Number of Bidders exceed the Quota.
3. High LSB.
4. High BpQ.

Modules that do not fit criteria 1. and 2. will not be considered popular. Amongst these modules, 3. and 4. will be used to determine which modules were most popular.

• The bar graphs below displays the mean LSB of Honor, Lab and Elective modules in Round 1A, averaged across all academic years, semesters, lecture slots (for modules with multiple lecture slots) and account types.
• Only modules with a median Quota of 40 and above (1.) and median BpQ more than 1 (2.) in Round 1A are displayed.
• Hover over the respective bars to view other statistics such as the mean/median number of Bidders, Quota, BpQ and LSB.

---

Honor Modules

---

Lab Modules

---

Elective Modules

The elective modules were not filtered by median Quota or BpQ because the Quota for elective varied greatly across different modules unlike the Lab and Honors modules. Here

---